perm filename GENINV[P,JRA] blob
sn#137080 filedate 1974-12-20 generic text, type T, neo UTF8
(DEFPROP GENINVAR*
(LAMBDA(CL DSW)
(PROG (LI SG SW LIT LICCL SIVAL SCCL LI*)
(COND ((NULL CL) (RETURN NIL)))
(SETQ CCL NIL)
(SETQ IBAL (VARLIST (GET OP (QUOTE IBAS))))
(SETQ IVAL (VARLIST CL))
(SETQ IGAL (VARLIST (GET OP (QUOTE IG))))
GE1 (SETQ SW NIL)
(SETQ LI (CAAR CL))
(COND
((CDAR CL) (SETQ SIVAL IVAL)
(SETQ SCCL CCL)
(SETQ SG (CONS (IDISJUN (CAR CL)) SG))
(SETQ IVAL SIVAL)
(SETQ CCL (CONS (CAR (REVERSE CCL)) SCCL))
(GO GE7)))
(COND ((EQ NEGSGN (CAR LI)) (SETQ SW T) (SETQ LI (CDR LI))))
(SETQ LICCL (PLPRED LI T))
(SETQ LI* LI)
(SETQ LI (PLPRED LI NIL))
(COND ((AND (NOT SW) (NOT (GET (CAR LI) (QUOTE PARTIAL))))
(SETQ SG
(CONS
(LIST (QUOTE THASSERT)
(APPEND (SUBSYV VARS LI*) @(R)))
SG))
(SETQ CCL
(CONS
(LIST (QUOTE SIMPLE)
(APPEND
(QUOTE (LIST))
(LIST
(CONS
(QUOTE QUOTE)
(LIST (CAR LI))))
(APPEND
(CDR LICCL)
(COND
((GET
(CAR LI)
(QUOTE FLUENT))
(QUOTE ((QUOTE R))))
(T NIL)))))
CCL))
(GO GE7))
((NOT (GET (CAR LI) (QUOTE PARTIAL))) (SETQ SG
(CONS (LIST (QUOTE THNOT)
(LIST (QUOTE THGOAL)
(APPEND LI
(COND
((GET
(CAR LI)
(QUOTE FLUENT))
(QUOTE (R)))
(T NIL)))
(QUOTE (THTBF FILTERAX))))
SG))
(SETQ CCL
(CONS (LIST (QUOTE SIMPLE)
(APPEND (QUOTE (LIST))
(LIST
(LIST (QUOTE QUOTE) NEGSGN)
(LIST (QUOTE QUOTE) (CAR LI)))
(APPEND (CDR LI)
(COND
((GET
(CAR LI)
(QUOTE FLUENT))
(QUOTE ((QUOTE R))))
(T NIL)))))
CCL))
(GO GE7)))
(SETQ LI (APPEND LI (COND ((GET (CAR LI) (QUOTE FLUENT)) (QUOTE (R))) (T NIL))))
(SETQ LIT LI)
(COND (SW (SETQ LI (CONS (READLIST (APPEND (QUOTE (N)) (EXPLODE (CAR LI)))) (CDR LI))))
(T (SETQ LIT (CONS (READLIST (APPEND (QUOTE (N)) (EXPLODE (CAR LI)))) (CDR LI)))))
(SETQ SG
(CONS (LIST (QUOTE THCOND)
(LIST (LIST (QUOTE THGOAL) LI) T)
(LIST (LIST (QUOTE THGOAL) LIT) (QUOTE (THFAIL)))
(LIST T
(LIST (QUOTE UNCERTLIT)
(APPEND (QUOTE (LIST)) (CONS (LIST (QUOTE QUOTE) (CAR LI)) (CDR LI)))
DSW
(LIST (QUOTE QUOTE) LI)
(LIST (QUOTE QUOTE) LIT))))
SG))
(COND ((NULL DSW) (SETQ SG (CONS (LIST (QUOTE CONDSTAT) (QUOTE (THV CGL)) DSW) SG))))
GE7 (SETQ CL (CDR CL))
(COND (CL (GO GE1)))
(RETURN (REVERSE SG))))
EXPR)